home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dde / ddeshr / ddeshrf.bas < prev    next >
BASIC Source File  |  1992-12-31  |  10KB  |  231 lines
  1. Option Explicit
  2.  
  3. '*********************************************************
  4. '   Misc. flags and data areas.
  5. '*********************************************************
  6. Global DDESHRD_Loaded As Integer
  7. Global rc As Integer
  8.  
  9. '*********************************************************
  10. '   NDDE Access Flags.
  11. '*********************************************************
  12. Global Const NDDEACCESS_REQUEST = 1
  13. Global Const NDDEACCESS_ADVISE = 2
  14. Global Const NDDEACCESS_POKE = 4
  15. Global Const NDDEACCESS_EXECUTE = 8
  16. Global Const NDDEACCESS_START_APP = 16
  17.  
  18. '*********************************************************
  19. '   NDDE Constants.
  20. '*********************************************************
  21. Global Const NDDE_NO_ERROR = 0
  22. Global Const MAX_NDDESHARENAME = 64
  23. Global Const MAX_PASSWORD = 15
  24. Global Const MAX_APPNAME = 255
  25. Global Const MAX_TOPICNAME = 255
  26. Global Const MAX_ITEMNAME = 255
  27.  
  28. '*********************************************************
  29. '   Passable ShareInfo structure.
  30. '*********************************************************
  31. Type PASSSHAREINFO
  32. AppName             As String * 256    ' MAX_APPNAME+1
  33. Topic               As String * 256    ' MAX_TOPICNAME+1
  34. Item                As String * 256    ' MAX_ITEMNAME+1
  35. Password1           As String * 15     ' MAX_PASSWORD
  36. Permissions1        As Long
  37. Password2           As String * 15     ' MAX_PASSWORD
  38. Permissions2        As Long
  39. End Type
  40.  
  41. '*********************************************************
  42. '   External functions.
  43. '*********************************************************
  44. Declare Function VBGetNodeName Lib "DDESH.dll" () As String
  45. Declare Function VBShareDel Lib "DDESH.dll" (ByVal szShareName$) As Integer
  46. Declare Function VBShareEnum Lib "DDESH.dll" (ByVal hWnd As Integer) As Integer
  47. Declare Function VBShareGetInfo Lib "DDESH.dll" (ByVal szShareName As String, PShare As PASSSHAREINFO) As Integer
  48. Declare Function VBShareUpdate Lib "DDESH.dll" (ByVal szShareName$, ByVal szAppName$, ByVal szTopName$, ByVal szItemName$, ByVal szPswd1$, ByVal szPswd2$, ByVal Perm1&, ByVal Perm2&) As Integer
  49.  
  50. Declare Function GetPrivateProfileString Lib "kernel" (ByVal szSection$, ByVal szEntry$, ByVal szDefault$, ByVal szReturnBuffer$, ByVal cbReturnBuffer%, ByVal lpszFilename$) As Integer
  51. Declare Function WritePrivateProfileString Lib "kernel" (ByVal szSection$, ByVal szEntry$, ByVal szString$, ByVal szFilename$) As Integer
  52.  
  53. Sub DeleteShare (ByVal szShareName As String)
  54.     Screen.MousePointer = 11
  55.     rc = VBShareDel(szShareName)
  56.     If rc <> NDDE_NO_ERROR Then
  57.         MsgBox "Delete of share entry gave a return code of" + Str$(rc) + ".", 48, "DDEShare Error"
  58.     Else
  59.         DDESHRM!lblStatus.Caption = szShareName + " has been deleted."
  60.         DDESHRM!ShareList.RemoveItem DDESHRM!ShareList.ListIndex
  61.     End If
  62.     Unload DDESHRD
  63.     Screen.MousePointer = 0
  64. End Sub
  65.  
  66. Function EditShare () As String
  67.     Dim PShare As PASSSHAREINFO
  68.     Dim i As Integer
  69.     Dim AccAccum As Integer
  70.  
  71.     DDESHRD!txtShareName.Text = UCase$(Trim$(DDESHRD!txtShareName.Text))
  72.     If DDESHRD!txtShareName.Text = "" Then
  73.         EditShare = "A Share Name must be specified."
  74.         DDESHRD!txtShareName.SetFocus
  75.         Exit Function
  76.     End If
  77.  
  78.     If Not DDESHRD!btnDelete.Enabled Then
  79.         rc = VBShareGetInfo(DDESHRD!txtShareName.Text, PShare)
  80.         If rc = NDDE_NO_ERROR Then
  81.             EditShare = DDESHRD!txtShareName.Text + " already exists."
  82.             DDESHRD!txtShareName.SetFocus
  83.             Exit Function
  84.         End If
  85.     End If
  86.  
  87.     If DDESHRD!txtAppName.Text = "" Then
  88.         EditShare = "An Application Name must be specified."
  89.         DDESHRD!txtAppName.SetFocus
  90.         Exit Function
  91.     End If
  92.  
  93.     For i = 0 To 4
  94.         AccAccum = AccAccum + DDESHRD!chkLvl1(i).Value + DDESHRD!chkLvl2(i).Value
  95.     Next i
  96.     If AccAccum = 0 Then
  97.         EditShare = "No Authority has been granted on either access level."
  98.         Exit Function
  99.     End If
  100.  
  101.     DDESHRD!txtLvl1Pswd.Text = UCase$(DDESHRD!txtLvl1Pswd.Text)
  102.     DDESHRD!txtLvl2Pswd.Text = UCase$(DDESHRD!txtLvl2Pswd.Text)
  103. End Function
  104.  
  105. Sub ModifyShare (ByVal szShare As String)
  106.     Dim PShare As PASSSHAREINFO
  107.     Screen.MousePointer = 11
  108.     rc = DoEvents()
  109.     DDESHRM!lblStatus.Caption = ""
  110.     If DDESHRD_Loaded Then Unload DDESHRD
  111.     Load DDESHRD
  112.     DDESHRD!txtShareName.Text = szShare
  113.     If szShare <> " " Then
  114.         DDESHRD!txtShareName.Enabled = False
  115.         DDESHRD!btnDelete.Enabled = True
  116.     Else
  117.         DDESHRD!btnDelete.Enabled = False
  118.     End If
  119.     DDESHRD.Show
  120.     If szShare <> " " Then
  121.         rc = VBShareGetInfo(szShare, PShare)
  122.         DDESHRD!chkLvl1(0).Value = Abs((PShare.Permissions1 And NDDEACCESS_REQUEST) <> 0)
  123.         DDESHRD!chkLvl1(1).Value = Abs((PShare.Permissions1 And NDDEACCESS_ADVISE) <> 0)
  124.         DDESHRD!chkLvl1(2).Value = Abs((PShare.Permissions1 And NDDEACCESS_POKE) <> 0)
  125.         DDESHRD!chkLvl1(3).Value = Abs((PShare.Permissions1 And NDDEACCESS_EXECUTE) <> 0)
  126.         DDESHRD!chkLvl1(4).Value = Abs((PShare.Permissions1 And NDDEACCESS_START_APP) <> 0)
  127.         DDESHRD!chkLvl2(0).Value = Abs((PShare.Permissions2 And NDDEACCESS_REQUEST) <> 0)
  128.         DDESHRD!chkLvl2(1).Value = Abs((PShare.Permissions2 And NDDEACCESS_ADVISE) <> 0)
  129.         DDESHRD!chkLvl2(2).Value = Abs((PShare.Permissions2 And NDDEACCESS_POKE) <> 0)
  130.         DDESHRD!chkLvl2(3).Value = Abs((PShare.Permissions2 And NDDEACCESS_EXECUTE) <> 0)
  131.         DDESHRD!chkLvl2(4).Value = Abs((PShare.Permissions2 And NDDEACCESS_START_APP) <> 0)
  132.         DDESHRD!txtLvl1Pswd.Text = Trim$(PShare.Password1)
  133.         DDESHRD!txtLvl2Pswd.Text = Trim$(PShare.Password2)
  134.         DDESHRD!txtAppName.Text = Trim$(PShare.AppName)
  135.         DDESHRD!txtTopName.Text = Trim$(PShare.Topic)
  136.         DDESHRD!txtItemName.Text = Trim$(PShare.Item)
  137.         DDESHRD!txtAppName.SetFocus
  138.     Else
  139.         DDESHRD!txtShareName.SetFocus
  140.     End If
  141.     Screen.MousePointer = 0
  142. End Sub
  143.  
  144. Sub SetAuthFocusMsg (AuthIndex As Integer, ByVal currValue As Integer)
  145.     Dim AuthType As String
  146.     Select Case AuthIndex
  147.         Case 0
  148.             AuthType = "execute a request."
  149.         Case 1
  150.             AuthType = "start an advise loop."
  151.         Case 2
  152.             AuthType = "poke data."
  153.         Case 3
  154.             AuthType = "issue executes."
  155.         Case 4
  156.             AuthType = "start the application on connect."
  157.     End Select
  158.     If currValue = 0 Then
  159.         DDESHRD!lblStatus.Caption = "Do not allow the destination application to " + AuthType
  160.     Else
  161.         DDESHRD!lblStatus.Caption = "Allow the destination application to " + AuthType
  162.     End If
  163. End Sub
  164.  
  165. Sub UpdateShare ()
  166.     Dim mbmsg As String
  167.     Dim Perm1 As Long
  168.     Dim Perm2 As Long
  169.     Dim ProfStr As String
  170.     Dim NewProfStr As String
  171.     Screen.MousePointer = 11
  172.     rc = DoEvents()
  173.     If DDESHRD!txtTopName.Text = "" Then
  174.         mbmsg = "A blank topic will cause connections to all topics to be honored." + Chr$(13) + Chr$(10)
  175.         mbmsg = mbmsg + "This will work but is not documented or supported." + Chr$(13) + Chr$(10)
  176.         mbmsg = mbmsg + "The updating will take place outside of normal NDDE protocol." + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
  177.         mbmsg = mbmsg + "Do you want to proceed?"
  178.         If MsgBox(mbmsg, 32 + 4, "") <> 6 Then
  179.             Screen.MousePointer = 0
  180.             Exit Sub
  181.         End If
  182.         DDESHRD!txtTopName.Text = "*"
  183.     Else
  184.         DDESHRD!txtTopName.Text = Trim$(DDESHRD!txtTopName.Text)
  185.     End If
  186.     DDESHRD!txtShareName.Text = Trim$(DDESHRD!txtShareName.Text)
  187.     DDESHRD!txtAppName.Text = Trim$(DDESHRD!txtAppName.Text)
  188.     DDESHRD!txtItemName.Text = Trim$(DDESHRD!txtItemName.Text)
  189.     DDESHRD!txtLvl1Pswd.Text = Trim$(DDESHRD!txtLvl1Pswd.Text)
  190.     DDESHRD!txtLvl2Pswd.Text = Trim$(DDESHRD!txtLvl2Pswd.Text)
  191.     Perm1 = 0
  192.     Perm2 = 0
  193.     Perm1 = Perm1 + (DDESHRD!chkLvl1(0).Value * NDDEACCESS_REQUEST)
  194.     Perm1 = Perm1 + (DDESHRD!chkLvl1(1).Value * NDDEACCESS_ADVISE)
  195.     Perm1 = Perm1 + (DDESHRD!chkLvl1(2).Value * NDDEACCESS_POKE)
  196.     Perm1 = Perm1 + (DDESHRD!chkLvl1(3).Value * NDDEACCESS_EXECUTE)
  197.     Perm1 = Perm1 + (DDESHRD!chkLvl1(4).Value * NDDEACCESS_START_APP)
  198.     Perm2 = Perm2 + (DDESHRD!chkLvl2(0).Value * NDDEACCESS_REQUEST)
  199.     Perm2 = Perm2 + (DDESHRD!chkLvl2(1).Value * NDDEACCESS_ADVISE)
  200.     Perm2 = Perm2 + (DDESHRD!chkLvl2(2).Value * NDDEACCESS_POKE)
  201.     Perm2 = Perm2 + (DDESHRD!chkLvl2(3).Value * NDDEACCESS_EXECUTE)
  202.     Perm2 = Perm2 + (DDESHRD!chkLvl2(4).Value * NDDEACCESS_START_APP)
  203.     rc = VBShareUpdate(DDESHRD!txtShareName.Text, DDESHRD!txtAppName.Text, DDESHRD!txtTopName.Text, DDESHRD!txtItemName.Text, DDESHRD!txtLvl1Pswd.Text, DDESHRD!txtLvl2Pswd.Text, Perm1, Perm2)
  204.     If rc <> NDDE_NO_ERROR Then
  205.         MsgBox "Update of share entry gave a return code of" + Str$(rc) + ".", 48, "DDEShare Error"
  206.     Else
  207.         DDESHRM!lblStatus.Caption = Trim$(DDESHRD!txtShareName.Text) + " has been updated."
  208.         If Not DDESHRD!btnDelete.Enabled Then DDESHRM!ShareList.AddItem DDESHRD!txtShareName.Text
  209.         If DDESHRD!txtTopName.Text = "*" Then
  210.             ProfStr = Space$(255)
  211.             rc = GetPrivateProfileString("DDEShares", DDESHRD!txtShareName.Text, "-1", ProfStr, Len(ProfStr), "SYSTEM.INI")
  212.             If rc < 1 Then
  213.                 Beep
  214.                 MsgBox "Failed to set topic to NULL."
  215.                 Exit Sub
  216.             End If
  217.             NewProfStr = Left$(ProfStr, InStr(ProfStr, ","))
  218.             NewProfStr = NewProfStr + Mid$(ProfStr, Len(NewProfStr) + 2)
  219.             rc = WritePrivateProfileString("DDEShares", DDESHRD!txtShareName.Text, NewProfStr, "SYSTEM.INI")
  220.             If rc < 1 Then
  221.                 Beep
  222.                 MsgBox "Failed to set topic to NULL."
  223.                 Exit Sub
  224.             End If
  225.         End If
  226.     End If
  227.     Unload DDESHRD
  228.     Screen.MousePointer = 0
  229. End Sub
  230.  
  231.